Unfallstatistik Regensburg

Konstantin Schneider

2021-09-30

Index

Aufgabe

Ein Datenprojekt Ihrer Wahl. Dies muss nicht in R realisiert sein, kann mit einem Werkzeug Ihrer Wahl entstehen.
Ziel: Text und überzeugende Darstellung der Ergebnisse.

1 Unfalldaten

Das Statistische Bundeamt stellt eine vielzahl an unterschiedlichen Datensätzen zur Verfügung. In diesem Dokument werden offizielle Unfalldaten mit Personenschaden für Regensburg ausgewertet. Diese können hier heruntergeladen werden.

library(tidyverse)
library(lubridate)
filenames <-
  list.files(
    path = here::here("data-raw/accidents")
  )
ReadGarbageData <- function(filename){

  # read a file
  data <- read_csv2(here::here("data-raw/accidents", filename))

  # the files have different headers
  # this key corrects that
  col_key <-
    c(
      # ids
      FID = "id1",
      OBJECTID = "id2",
      OBJECTID_1 = "id2",
      UIDENTSTLA = "id3",
      UIDENTSTLAE = "id3",
      # lighting
      ULICHTVERH = "light_condition",
      LICHT = "light_condition",
      # street condition
      IstStrasse = "street_condition",
      STRZUSTAND = "street_condition",
      # other
      IstSonstig = "other",
      IstSonstige = "other",
      # common
      ULAND = "land",
      UREGBEZ = "bezirk",
      UKREIS = "kreis",
      UGEMEINDE = "gemeinde",
      UJAHR = "year",
      UMONAT = "month",
      USTUNDE = "hour",
      UWOCHENTAG = "weekday",
      UKATEGORIE = "severity",
      UART = "kind_of_accident",
      UTYP1 = "type_of_accident",
      IstRad = "bicycle",
      IstKrad = "bike",
      IstPKW = "car",
      IstFuss = "pedestrian",
      IstGkfz = "truck",
      LINREFX = "linref_x",
      LINREFY = "linref_y",
      XGCSWGS84 = "lng",
      YGCSWGS84 = "lat"
    )

  # correct col names via the key
  names(data) <- col_key[names(data)]

  # correct col types
  data <-
    data |>
    mutate(
      bezirk = as.character(bezirk),
      year = as.numeric(year),
      month = as.numeric(month),
      hour = as.numeric(hour)
    )

  return(data)
}
data <-
  filenames |>
  map_dfr(
    ReadGarbageData
  ) |>
  select(-starts_with("id"))
data <-
  data |>
  filter(
    land == "09" &
    bezirk == "3" &
    kreis == "62" &
    gemeinde == "000"
  ) |>
  select(-kind_of_accident, -type_of_accident, -linref_x, -linref_y) |>
  select(-land, -bezirk, -kreis, -gemeinde)

# add id
data <-
  data |>
  mutate(
    id = row_number()
  ) |>
  select(id, everything())
data <-
  data |>
  mutate(
    datetime = glue::glue("{month}-{year}-{hour}") |>
      parse_datetime(format = "%m-%Y-%H")
  ) |>
  mutate(
    weekday = wday(weekday, label = TRUE),
    date = date(datetime)
  ) |>
  mutate(
    across(
      .cols = c(severity, light_condition, street_condition),
      .fns = as_factor
    )
  ) |>
  mutate(
    across(
      .cols = bicycle:other,
      .fns = as.logical
    )
  ) |>
  mutate(
    severity = fct_recode(
      severity,
      "Toedlich" = "1",
      "Schwer" = "2",
      "Leicht" = "3"
    ),
    light_condition = fct_recode(
      light_condition,
      "Tageslicht" = "0",
      "Dämmerung" = "1",
      "Dunkelheit" = "2"
    ),
    street_condition = fct_recode(
      street_condition,
      "Trocken" = "0",
      "Nass/Feucht" = "1",
      "Winterglatt" = "2"
    )
  )
data |> 
  DT::datatable()

1.1 Geocode

# pb <- 
#   progress::progress_bar$new(
#     format = "Lade Geodaten :current/:total [:bar] :percent (eta: :eta)",
#     total = nrow(data)
#   )
# 
# pb$tick(0)
# 
# data <- 
#   map2_dfr(
#     .x = data$lng,
#     .y = data$lat,
#     .f = function(x = .x, y = .y){
#       
#       geodata <- photon::reverse(x, y) |> 
#         select(name:country)
#       
#       pb$tick()
#       
#       return(geodata)
#     }
#   ) |>
#   mutate(
#     id = row_number(),
#     street = ifelse(is.na(street), name, street)
#   ) |>
#   right_join(data, by = c("id"))
# 
# remove(pb)

1.2 CSV/RDA speichern.

# data
write_csv2(
  x = data,
  file = here::here("output/regensburg_data.csv")
)

save(
  list = c("data"),
  file = here::here("data/regensburg_data.rda")
)

2 Shapefiles

library(tidyverse)
library(sf)

Die restlichen Shapefiles (Stadtgrenze, Stadtteile, Gewässer, Autobahnen) stammen vom Amt für Stadtentwicklung Regensburg

2.1 Stadtgrenze Regensburg

sf.regensburg <- 
  read_sf(here::here("data-raw/shapefiles/regensburg/gesamtstadt.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "m2" = qm
  ) |>
  select(m2, geometry)
ggplot() +
  geom_sf(data = sf.regensburg) +
  ggthemes::theme_map()

2.2 Stadtteile

sf.districts <- 
  read_sf(here::here("data-raw/shapefiles/districts/stadtbezirke.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "district" = Name,
    "ha" = Hektar
  ) |> 
  mutate(
    m2 = ha * 10^4
  ) |> 
  select(district, m2, geometry)
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.3 Autobahnen

sf.highways <- 
  read_sf(here::here("data-raw/shapefiles/highways/autobahn.shp")) |> 
  st_transform("WGS84") |> 
  rename(
    "feeder" = ZUBRINGER
  ) |> 
  mutate(
    feeder = case_when(
      feeder == "j" ~ TRUE,
      feeder == "n" ~ FALSE
    )
  )
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.highways, alpha = 0.6) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.4 Flüsse

sf.rivers <- 
  read_sf(here::here("data-raw/shapefiles/rivers/gewaesser.shp")) |> 
  st_transform("WGS84") |> 
  select(geometry)
ggplot() +
  geom_sf(data = sf.districts, linetype = 2) +
  geom_sf(data = sf.rivers, alpha = 0.6) +
  geom_sf(data = sf.highways, alpha = 0.6) +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  ggthemes::theme_map()

2.5 Finale Karte

ggplot() +
  geom_sf(data = sf.districts, aes(fill = district), alpha = 0.7) +
  geom_sf(data = sf.rivers, alpha = 0.7, fill = "lightblue") +
  geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
  theme_void() +
  theme(
    legend.position = "right",
    legend.title = element_blank()
  )

3 Leaflet Karte

library(tidyverse)
library(leaflet)
library(sf)
sf.data <-
  data |> 
  st_as_sf(coords = c("lng", "lat"), crs = "WGS84")

3.1 Basemap

bounds <- sf.regensburg |> st_bbox()

map <- 
  leaflet(
    options = leafletOptions(
      crs = leafletCRS(code = "WGS84"),
      preferCanvas = NULL
    )
  ) |> 
  addProviderTiles(
    provider = providers$OpenStreetMap.DE,
    group = "OSM",
    options = providerTileOptions(minZoom = 11)
  ) |> 
  setView(
    lng = (as.numeric(bounds[1]) + as.numeric(bounds[3]))/2,
    lat = (as.numeric(bounds[2]) + as.numeric(bounds[4]))/2,
    zoom = 12
  ) |> 
  setMaxBounds(
    lng1 = as.numeric(bounds[1] - 0.015), 
    lat1 = as.numeric(bounds[2] - 0.015), 
    lng2 = as.numeric(bounds[3] + 0.015), 
    lat2 = as.numeric(bounds[4] + 0.015)
  )

3.2 Marker

custom_popup <- function(data, header) {
  text <- 
    glue::glue(
      "<b>{header}</b> ",
      "<br>",
      "{data$month}/{data$year} ({data$hour} Uhr)"
    )
  return(text)
}
map <- 
  map |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Toedlich"),
    group = "Tödliche Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "red"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Toedlich"), 
      header = "Tödlicher Unfall"
    )
  ) |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Schwer"),
    group = "Schwere Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "orange"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Schwer"), 
      header = "Schwerer Unfall"
    )
  ) |> 
  addAwesomeMarkers(
    data = data |> filter(severity == "Leicht"),
    group = "Leichte Unfälle",
    lng = ~lng,
    lat = ~lat,
    icon = awesomeIcons(
      icon = 'ios-close',
      iconColor = 'black',
      library = 'ion',
      markerColor = "beige"
    ),
    clusterOptions = markerClusterOptions(),
    popup = custom_popup(
      data = data |> filter(severity == "Leicht"), 
      header = "Leichter Unfall"
    )
  )

3.3 Stadtteile als Shapefile

custom_label <- function(data) {
  text <- glue::glue(
    "{data$district}: {data$n} Unfälle"
  )
  return(text)
}
districts <-
  data |> 
  st_as_sf(coords = c("lng", "lat"), crs = "WGS84") |> 
  rename(
    points = geometry
  ) |> 
  st_join(
    y = sf.districts |> rename("district_shape" = geometry),
    join = st_within,
    left = TRUE
  ) |> 
  select(-m2) |> 
  as_tibble() |> 
  left_join(
    y = sf.districts |> rename("district_polygon" = geometry) ,
    by = "district"
  ) |>
  drop_na(district) |>
  mutate(
    district = as_factor(district) |>
      fct_infreq() |>
      fct_rev()
  ) |> 
  add_count(district) |> 
  select(district, district_polygon, n) |> 
  unique() |> 
  st_as_sf()
map <-
  map |> 
  addPolygons(
    data = districts,
    group = "Stadtteile",
    opacity = 1,
    weight = 0.5, 
    fillOpacity = 0.5,
    color = "black",
    fillColor = ~colorNumeric("viridis", n)(n),
    highlightOptions = highlightOptions(
      color = "white", 
      weight = 2,
      bringToFront = TRUE
    ),
    label = ~custom_label(data = districts)
  )

3.4 Bedienelemente

map <- 
  map |> 
    addProviderTiles(
      provider = providers$Stamen.TonerBackground,
      group = "Stadtteile",
      options = providerTileOptions(minZoom = 11)
    ) |> 
    addLayersControl(
      baseGroups = c("OSM", "Stadtteile"),
      overlayGroups = c("Tödliche Unfälle", "Schwere Unfälle", "Leichte Unfälle"),
      options = layersControlOptions(collapsed = FALSE)
    )

3.5 Finale Karte

map

4 Auswertung

Zur besseren Lesbarkeit wird der R Code in diesem Kapitel nicht gezeigt. Dieser besteht größtenteils aus Plots und ist bis auf wenige Ausnahmen nicht weiter relevant.

Im Stadtgebiet Regensburg geschahen von den Jahren 2016 bis 2020 insgesamt 3167 Unfälle mit Personenschaden. Abbildung 4.1 zeigt die monatlichen Unfälle in diesem Zeitraum.

Monatliche Unfälle in Regensburg.

Abbildung 4.1: Monatliche Unfälle in Regensburg.

Während sich kein eindeutiger Auf- oder Abwärtstrend feststellen lässt, zeigen die Daten dennoch eine Jährliche Periodizität: Im Sommer finden die meisten Unfälle mit Personenschaden statt, während die Anzahl der Unfälle von Herbst bis Frühjahr sinkt.

Abbildung 4.2 zeigt die Anzahl der jährlichen Unfälle in Regensburg. Im Jahr 2020 zeigt sich ein Rückgang von 25%. Dieser kann auf geringeren Verkehr aufgrund der Corona Pandemie zurückgeführt werden. Dies wird durch Abbildung 4.3 verdeutlicht: Alle dokumentierten Verkehrsmittel hatten einen Rückgang der jährlichen Unfälle von 2019 bis 2020.

Jährliche Unfälle mit Personenschaden.

Abbildung 4.2: Jährliche Unfälle mit Personenschaden.

Abbildung 4.3 zeigt zudem, dass sich die Anzahl der Unfälle aller Verkehrsmittel außer Fahrrad auf einem fallenden Trend befinden. Die Anzahl der Unfälle mit Fahrradbeteiligung dagegen stieg bis 2020 kontinuierlich an.

Jährliche Unfälle mit Personenschaden nach Verkehrsteilnehmer unterteilt.

Abbildung 4.3: Jährliche Unfälle mit Personenschaden nach Verkehrsteilnehmer unterteilt.

4.1 Unfälle nach Monat

4.2 Unfälle nach Uhrzeit

4.3 Unfälle nach Ortsteil

4.3.1 Absolute Anzahl

4.3.2 Pro Quadratkilometer

Sonstiges

A Dashboard

knitr::include_url("https://kdschneider.shinyapps.io/unfaelle-regensburg/")

B Daten

load(
  here::here("data/regensburg_data.rda")
)
data |> 
  DT::datatable()

Verwendete Pakete

Cheng, Joe, Bhaskar Karambelkar, and Yihui Xie. Leaflet: Create Interactive Web Maps with the JavaScript Leaflet Library, 2021. https://rstudio.github.io/leaflet/.
Grolemund, Garrett, and Hadley Wickham. “Dates and Times Made Easy with lubridate.” Journal of Statistical Software 40, no. 3 (2011): 1–25. https://www.jstatsoft.org/v40/i03/.
Pebesma, Edzer. Sf: Simple Features for r, 2021. https://CRAN.R-project.org/package=sf.
———. “Simple Features for R: Standardized Support for Spatial Vector Data.” The R Journal 10, no. 1 (2018): 439–46. https://doi.org/10.32614/RJ-2018-009.
Spinu, Vitalie, Garrett Grolemund, and Hadley Wickham. Lubridate: Make Dealing with Dates a Little Easier, 2021. https://CRAN.R-project.org/package=lubridate.
Wickham, Hadley. Tidyverse: Easily Install and Load the Tidyverse, 2021. https://CRAN.R-project.org/package=tidyverse.
Wickham, Hadley, Mara Averick, Jennifer Bryan, Winston Chang, Lucy D’Agostino McGowan, Romain François, Garrett Grolemund, et al. “Welcome to the tidyverse.” Journal of Open Source Software 4, no. 43 (2019): 1686. https://doi.org/10.21105/joss.01686.